home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-07-15 | 9.8 KB | 395 lines | [TEXT/MPS ] |
- {© G. Sawitzki, StatLab Heidelberg 1986-1991}
-
- {----------------- Main Routines ------------------}
-
-
- PROCEDURE MyInit; {(var TheState : TaskStateType)}
-
- const
- chsize=128; chdelta=5;
- cvsize=128; cvdelta=5;
- cvtsize=40;
- var myTaskHandler:tTaskHandler;
- myMasterTaskHandler:tMasterTaskHandler;
- mySlaveTaskHandler:tSlaveTaskHandler;
- myTaskGenerator:tMyTaskGenerator;
- myResultHandler:tReplyResultHandler;
- h:MenuHandle;
- s:str255;
- i:integer;
- myNamePtr:^str31;
- ptyp:integer;
- hc:tConfigurationHandle;err:oserr;
- h1:handle;
- myPic:PicHandle;
-
- procedure fatal;
- var
- scrl:longint;
- begin
- progressreport(0,'NetSim ');
- progressreport(1,'could not be launched');
- progressreport(3,'This program needs a NetWork Processor');
- progressreport(2,'This program needs ColorQuickdraw');
- progressreport(4,'Please consult the documentation.');
- ShowProgress;{make shure all is drawn and visible}
- Delay(300,scrl);
- halt;
- end;
-
- BEGIN
- h1:=GetResource('NSSY',128);
- if GetHandleSize(h1)<>sizeOf(tConfiguration) then ProgramBreak('bad NSSY resource size');
- hc:=tConfigurationHandle(h1);
- err:=ResError;if (err<>noErr) | (hc=nil) then ProgramBreak('could not load NSSY configuration');
- if hc^^.version<>5 then ProgramBreak('bad NSSY configuration version')
- else theConfiguration:=hc^^;
-
- ReleaseResource(handle(hc));
-
- gNextNetRefresh:=tickcount+CNetRefreshDelta;
-
- gSoldResults:='';
-
- nextTicks:=tickCount+TicksDelta;
- repeat until ReadDateTime(oldTime)=noErr;
- goldtime:=oldtime;
- nrResults:=0;
- gnrResults:=0;
- gProtocolOn:=false;
- with theConfiguration do begin
- if ShowControlMenu then begin
- InsertMenu(GetMenu(128),0);
- DrawMenuBar;
- end;
- end;
-
- {prepare your workarea here}
- gTaskState := TaskNew;
-
- if InitNetwork(NetWorkEvt)<>NoErr then fatal;
- if NlInit<>noErr then fatal;
-
- {NetWorkScheduler installation}
- new(NetWorkScheduler);
- if NetWorkScheduler=nil then fatal;
-
- NetWorkScheduler.init;
-
- if NetWorkScheduler.err=NoErr then
- begin
- NetWorkScheduler.TaskIterations:=theconfiguration.samplesize;
- StatisticWindow:=nil;
-
-
- with nform do begin
- style:= FixedDecimal;
- digits:=2;
- END;
-
- if master then begin
- new(myMasterTaskHandler); myTaskHandler:=tTaskHandler(myMasterTaskHandler);
-
-
- end else begin
- new(mySlaveTaskHandler); new(myResultHandler);
- if myResultHandler<> nil then myResultHandler.init;
- mySlaveTaskHandler.ResultHandler:=myResultHandler;
- myTaskHandler:=tTaskHandler(mySlaveTaskHandler);
-
-
- end;
-
- {new(myTaskHandler);}
- if myTaskHandler<>nil then NetWorkScheduler.InitTaskHandler(myTaskHandler);
- end;{if NetWorkScheduler.err=NoErr then }
-
-
- {end of NetWorkScheduler installation}
-
- randseed:=tickCount;
- tToy_init(theConfiguration.SampleSize);
-
-
- doopen(cnew); {for example, fake a new-command}
- BaseWindow:=Frontwindow; {no close box on this one, so it will always exist}
- baserect:=BaseWindow^.portrect;
- baserect.left:=baserect.left+200;
- fillRect(baserect,ltgray);
-
- system.windowcount:=3;{leave some space}
- MakeAWindow('Record Min/Max Samples', 300, 100, -noGrowDocProc);
- RecordWindow:=Frontwindow;
- {$Ifc false}
- minrect:=RecordWindow^.portrect;
- minrect.bottom:=minrect.bottom-50;
- maxrect:=RecordWindow^.portrect;
- maxrect.top:=maxrect.top+50;
- setrect(minrect,0,0,300,50);
- {$Endc}
- setrect(minrect,0,10,100,40);
-
- setrect(maxrect,0,60,100,90);
- setport(RecordWindow);
-
- minPic:=openPicture(minrect);
- showpen;
- framerect(minrect);
- fillrect(minrect,ltGray);
- hidepen;
- closePicture;
-
- maxPic:=openPicture(maxrect);
- showpen;
- framerect(maxrect);
- fillrect(maxrect,dkGray);
- hidepen;
- closePicture;
-
- NewRecordPicture;
-
- minRecord:=+inf;
- maxRecord:=-inf;
- if system.GraficModel<>ColorQuickdrawModel
- THEN fatal;
-
- IF master THEN BEGIN
- new(myTaskGenerator);
- IF myTaskGenerator<>NIL THEN BEGIN
-
- NetWorkScheduler.initTaskGenerator(myTaskGenerator);
- END;
-
- StatisticWindow:=GetNewWindow(129,@StatisticWindowRec,Pointer(-1));{should go to open}
- initstatistics;
- setrect(localhrect,0,0,chsize,cvsize);offsetrect(localhrect,chdelta,cvdelta);
- setrect(totalhrect,0,0,chsize,cvsize);offsetrect(totalhrect,chsize+2*chdelta,cvdelta);
-
- setrect(localsrect,0,0,chsize,cvtsize);offsetrect(localsrect,chdelta,cvsize+2*cvdelta);
- setrect(totalsrect,0,0,chsize,cvtsize);offsetrect(totalsrect,chsize+2*chdelta,cvsize+2*cvdelta);
-
- setrect(pcomprect,0,0,chsize,cvsize);offsetrect(pcomprect,chdelta,
- cvsize+3*cvdelta+cvtsize);
- setrect(qcomprect,0,0,chsize,cvsize);offsetrect(qcomprect,chsize+2*chdelta,
- cvsize+3*cvdelta+cvtsize);
- END;
-
- with gMsgHeader do begin
- traceinfo:=0;
- version:=cMyMsgHeaderVersion;
- action:=aNoop;
- ContentsToken:=longint('NONE');
- DistributionToken:=longint(cDefaultDistribution);
- DisplayToken:=longint(cDefaultDisplay);
- SampleSize:=50;
- end;
- END;
-
- {Application equivalent of system Task: this is your main program}
- PROCEDURE MyTask(phase : BackPhase);
- const
- cForeGroundSleep=0;
- cBackGroundSleep=10;
- BEGIN
- {do your job here}
- CASE phase OF
- BackBegin : begin{we are going to the background}
- {progressreport(1,'Template is in background')};
- if gWaitNextEventSleep>=cForeGroundSleep then gWaitNextEventSleep:=cForeGroundSleep;
- end;
- BackContinue : {we are called again}
- begin
- if gInBackground then {if you want special background tasks done}
- begin if gWaitNextEventSleep>cBackGroundSleep then gWaitNextEventSleep:=cBackGroundSleep;
- if master then DoLocalTask;
- {invertrect(thePort^.portrect) }{ do it here.}
- { this is just a quick&dirty example }
- end else begin
- if master then DoLocalTask;
- if gWaitNextEventSleep>cForeGroundSleep then gWaitNextEventSleep:=cForeGroundSleep;
- end;
- end;
- BackEnd : {we are coming from background}
- begin
- {hideprogress;}
- { this was just a quick&dirty example, let's clean up}
- if gWaitNextEventSleep>cForeGroundSleep then gWaitNextEventSleep:=cForeGroundSleep;
- eraserect(thePort^.portrect);
- invalrect(thePort^.portbits.bounds);
- end;
- OTHERWISE {should not occur}
- END;
- if TickCount>gNextNetRefresh then begin
- DrawStatisticWindow;
- gNextNetRefresh:=TickCount+cNetRefreshDelta;
- end;
- if master then gTaskState := TaskOk else gTaskState:=TaskIdle; {if all is ok}
- END;
-
- PROCEDURE MyCleanUp;
- var msg:msgPtr;
- me,Dest:msgAddr;
- BEGIN
- {clean up any mess you have done here. Save your results}
- if gProtocolOn then close(OutFile);
-
- {send a goodbye message via broadcast to release all partners}
- preparemessageHeader(gMsgHeader,aDone);
- me:=NetWorkScheduler.MySelf;
- Dest.p:=NetWorkScheduler.MySelf.p;
- Dest.a := -1; { broadcast }
- if master then if postmsg(msg,nil,cMsgNAttention+cMustBeLaunched,
- NetWorkScheduler.TaskGenerator.ContextStamp,
- Dest,me,
- @gMsgHeader,sizeof(gMsgHeader),nil,0)<>noErr then;
- if NetWorkScheduler<>nil then NetWorkScheduler.free;
-
- END;
-
- {-------------------- routines on request -------------------------}
-
- PROCEDURE doopen;
- CONST
- height = 100;{just for example}
- width = 300;
- VAR
- anyStr,s : Str255;
- anyindex : integer;
- anyFaktor, anyScale : real;
- anyHandle : PicHandle;
- val:extended;
- mytime:longint;q:extended;
- BEGIN
- CASE itsCmdNumber OF
- cnew :
- BEGIN
- {save old results}
- if ReadDateTime(myTime)=NoErr then
- begin
- q:=(mytime-goldTime);
- NumToString(round(q),s);
- numtostring(gnrResults,gsOldResults);
-
- gsOldResults:=concat('Zeit: ',s,' s #: ',gsOldResults);
- end;
-
- nextTicks:=tickCount+TicksDelta;
-
- repeat until ReadDateTime(oldTime)=noErr;
-
- gnrResults:=0;
- nrResults:=0;
-
- {just an example- make a sample window}
-
- anyStr := ('Local Sample');
- if system.WindowCount =0 then
- { two types, for example: with no Grow, no GoAway}
- MakeAWindow(anyStr, width, height, -noGrowDocProc);
-
- {define your own real 2d coordinates}
- setcoord(-system.WindowCount, 1, system.WindowCount, -1);
-
- sInit;
- END;
- cOpen :
- ;
- OTHERWISE {should not occur}
- END;
- END;
-
- {=============================================================================}
-
- {take a picture ask for a file name, and store the picture in file. Fake MacDraw file}
-
- procedure saveas(ThePic: PicHandle);
- type
- TMDHdr = record {PICT 1 header}
- ftype: OSType;
- hdrid: integer;
- version: integer;
- prRec: array[1..60] of integer;
- xorigin: Fixed;
- yorigin: point;
- xscale: point;
- yscale: point;
- atrstate: array[1..31] of integer;
- lcnt: integer;
- ltot: Integer;
- lsiz: longint;
- lr2d: rect;
- filler1: array[1..141] of integer
- end;
- var
- header: TMDHdr;
- tempReply: SFReply;
- Helpfi: TFileinfo;
-
- temperr: oserr;
- tempref: integer;
- Proposal: str255;
- P: ptr;
- count: longint;
- r: rect;
- begin
-
- numtostring(tickcount, proposal);
- proposal := concat( 'Template.', proposal);
- with header do begin
- ftype := 'PICT';
- hdrid := 0;
- version := 0;
- end;
- if ThePic <> nil then begin
- SFPutFile(System.SFPutPoint, 'Save graph as…', Proposal, nil, tempReply);
- if tempreply.good then begin {try to open file}
- if create(tempreply.fname, tempreply.VRefNum, 'MDPL', 'PICT') <> noerr then
- else begin
- temperr := FSOpen(tempreply.fname, tempreply.VRefNum, tempref);
- hlock(handle(thePic));
- count := 512;
- temperr := FsWrite(tempref, count, @header);
- count := gethandlesize(Handle(ThePic));
- temperr := FsWrite(tempref, count, Ptr(thepic^));{write picture contents}
- hunlock(handle(thePic));
- temperr := fsclose(tempref);{close file}
- end;
- end;
-
- end;
- end;
-
- {=============================================================================}
-
-
- PROCEDURE dosave;
- var ThePic:PicHandle;
- TheFrontWindow:WindowPtr;
- BEGIN
- CASE itsCmdNumber OF
- cSave :
- ;
- cSaveAs : {this is a bad, but helpful example. if the frontwindow has a picture,
- we save it in a Pict file, and claim to be MacDraw}
- begin
- TheFrontWindow:=frontwindow;
- if TheFrontWindow<>nil then begin
- ThePic:=PicHandle(GetWindowPic(TheFrontWindow));
- if ThePic<>nil then saveas(ThePic);
- end;
- end;
- cSaveCopy :
- ;
- OTHERWISE {should not occur}
- END;
- END;
-
- PROCEDURE doclose;
- BEGIN
- CASE itsCmdNumber OF
- cClose :
- ;
- OTHERWISE {should not occur}
- END;
- END;
-